home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / compress / icelhab4 / ice.bas < prev    next >
Encoding:
BASIC Source File  |  1995-08-08  |  5.1 KB  |  140 lines

  1. ' ---------------------------------------------------------
  2. '       Copyright (C) 1995 Stephen Darlington
  3. '
  4. ' The distrubution of this file is covered by the
  5. ' agreement in the ICE help file.
  6.  
  7. Option Explicit
  8. '
  9. ' ICE function declarations
  10. Declare Function Freeze Lib "ice.dll" (ByVal lpMask As String, ByVal lpLZH As String, ByVal fuOptions As Long) As Integer
  11. Declare Function Thaw Lib "ice.dll" (ByVal lpMask As String, ByVal lpLZH As String, ByVal fuOptions As Long) As Integer
  12. Declare Function TestArchive Lib "ice.dll" (ByVal lpLZH As String) As Integer
  13. Declare Function ListArchive Lib "ice.dll" (ByVal lpMask As String, ByVal lpLZH As String, ByVal lpStr As String) As Integer
  14. Declare Function AddComment Lib "ice.dll" (ByVal lpLZH As String, ByVal lpComment As String) As Integer
  15. Declare Function DeleteComment Lib "ice.dll" (ByVal lpLZH As String) As Integer
  16. Declare Function GetCommentLength Lib "ice.dll" (ByVal lpLZH As String) As Integer
  17. Declare Function GetComment Lib "ice.dll" (ByVal lpLZH As String, ByVal lpComment As String) As Integer
  18. Declare Function DeleteComment Lib "ice.dll" (ByVal lpLZH As String) As Integer
  19. Declare Function ShowComment Lib "ice.dll" (ByVal lpLZH As String) As Integer
  20. Declare Sub InitialiseICE Lib "ice.dll" (ByVal hMain As Integer, ByVal hDisplay As Integer, ByVal fuOptions As Long)
  21. Declare Sub AboutICE Lib "ice.dll" ()
  22. '
  23. ' Constant for Freeze
  24. Global Const ICE_STOREFULLPATHS = &H0&          'default
  25. Global Const ICE_STORERELATIVEPATHS = &H1&
  26. Global Const ICE_STORENOPATHS = &H2&
  27. Global Const ICE_RECURSIVE = &H4&
  28. Global Const ICE_INCLUDEARCHIVEFILES = &H10&
  29. Global Const ICE_INCLUDEREADONLYFILES = &H20&
  30. Global Const ICE_INCLUDESYSTEMFILES = &H40&
  31. Global Const ICE_INCLUDEHIDDENFILES = &H80&
  32. Global Const ICE_INCLUDENORMALFILES = &H100&    'default
  33. Global Const ICE_TURNARCHIVEOFF = &H200&
  34. Global Const ICE_TURNREADONLYOFF = &H400&
  35. Global Const ICE_TURNSYSTEMOFF = &H800&
  36. Global Const ICE_TURNHIDDENOFF = &H1000&
  37. '
  38. ' Constants for Thaw
  39. Global Const ICE_RESTOREDIRECTORIES = &H1&
  40. Global Const ICE_DELETEFILES = &H2&
  41.  
  42. ' Constants for Freeze and Thaw
  43. Global Const ICE_MOVEFILES = &H8&
  44. Global Const ICE_OVERWRITEALL = &H2000&
  45. Global Const ICE_OVERWRITEIFNEWER = &H4000&
  46. Global Const ICE_OVERWRITEQUERY = &H8000&       'default for both
  47. Global Const ICE_OVERWRITENEVER = &H10000
  48.  
  49. ' Constants for InitailiseICE
  50. Global Const ICE_PASSPERCENT = &H1&
  51. Global Const ICE_PASSFILENAME = &H2&
  52.  
  53. ' User-defined type for ListArchiveContents
  54. Type ICEINFO_TYPE
  55.     sPath As String
  56.     sFilename As String
  57.     sDate As String * 8
  58.     sTime As String * 8
  59.     sAttributes As String * 4
  60.     lOriginalSize As Long
  61.     lCompressedSize As Long
  62.     sRatio As String * 3
  63.     sMethod As String * 5
  64.     sCRC As String * 4
  65. End Type
  66.  
  67. Function GetPiece (from As String, delim As String, Index As Integer) As String
  68.     Dim temp$
  69.     Dim Count As Integer
  70.     Dim Where As Integer
  71.     '
  72.     temp$ = from & delim
  73.     Where = InStr(temp$, delim)
  74.     Count = 0
  75.     Do While (Where > 0)
  76.         Count = Count + 1
  77.         If (Count = Index) Then
  78.             GetPiece = Left$(temp$, Where - 1)
  79.             Exit Function
  80.         End If
  81.         temp$ = Right$(temp$, Len(temp$) - Where)
  82.         Where = InStr(temp$, delim)
  83.     Loop
  84.     If (Count = 0) Then
  85.         GetPiece = from
  86.     Else
  87.         GetPiece = ""
  88.     End If
  89. End Function
  90.  
  91. Function ListArchiveContents (sMask As String, sLZH As String, info() As ICEINFO_TYPE)
  92. '
  93. ' VB function wrapper around the ICE function ListArchive
  94. '
  95. ' sMask      - the files to retrieve (e.g. *.DLL or *.DOC)
  96. ' sLZH       - the path and filename of the archive (e.g. C:\TEMP\ICE.LZH)
  97. ' info()     - an array of type ICEINFO_TYPE provided by the user
  98. '
  99. ' This function returns the number of files retrieved into the
  100. ' users array if the function is successful. If the function is
  101. ' not successful, a (negative) error code is returned.
  102. '
  103.     Dim all$, sTemp$
  104.     Dim I As Integer
  105.     Dim iCount As Integer
  106.     Dim iCarat As Integer
  107.     '
  108.     all$ = String(60000, " ")
  109.     iCount = ListArchive(sMask, sLZH, all$)
  110.     If (iCount <= 0) Then
  111.         all$ = ""
  112.         ListArchiveContents = iCount
  113.         If (iCount < -1) Then
  114.             End
  115.         Else
  116.             Exit Function
  117.         End If
  118.     End If
  119.     all$ = Left$(all$, InStr(all$, Chr$(0)) - 1)
  120.     ReDim info(iCount)
  121.     For I = 1 To iCount Step 1
  122.         iCarat = InStr(all$, "^")
  123.         sTemp$ = Left$(all$, iCarat - 1)
  124.         info(I).sPath = GetPiece(sTemp$, "#", 1)
  125.         info(I).sFilename = GetPiece(sTemp$, "#", 2)
  126.         info(I).sDate = GetPiece(sTemp$, "#", 3)
  127.         info(I).sTime = GetPiece(sTemp$, "#", 4)
  128.         info(I).sAttributes = GetPiece(sTemp$, "#", 5)
  129.         info(I).lOriginalSize = Val(GetPiece(sTemp$, "#", 6))
  130.         info(I).lCompressedSize = Val(GetPiece(sTemp$, "#", 7))
  131.         info(I).sRatio = GetPiece(sTemp$, "#", 8)
  132.         info(I).sMethod = GetPiece(sTemp$, "#", 9)
  133.         info(I).sCRC = GetPiece(sTemp$, "#", 10)
  134.         all$ = Right$(all$, (Len(all$) - iCarat))
  135.     Next I
  136.     all$ = ""
  137.     ListArchiveContents = iCount
  138. End Function
  139.  
  140.